home *** CD-ROM | disk | FTP | other *** search
/ MacWorld: Complete Mac Interactive / Macworld Complete Mac Interactive CD)(1994).iso / The Best of BMUG / Utilities / Text and Speech / Alpha.5.76 / Tcl / SystemCode / shell.tcl < prev    next >
Encoding:
Text File  |  1994-03-11  |  5.8 KB  |  240 lines  |  [TEXT/ALFA]
  1.  
  2. ################################################################################
  3. # Shell routines.
  4. ################################################################################
  5.  
  6.  
  7. proc setShellMode {} {
  8.     setTclMode
  9.     changeMode "Csh"
  10.     insertMenu "Tcl"
  11. }
  12.  
  13. proc initShell {} {
  14.     insertText "Welcome to Alpha's Tcl shell."
  15.     insertText -w [lindex [winNames] 0] [shellPrompt]
  16. }
  17.  
  18. # Return the prompt. We want the window name because some of the commands
  19. # we evaluate (such as 'edit') open a new window, and we want the insertion
  20. # to be done in the shell window.
  21. proc shellPrompt {} {
  22.     regexp "(\[^:\]*):$" [pwd] crDum crDir
  23.     return "\r$crDir> "
  24. }
  25.  
  26.  
  27. # Called at all carriage returns.
  28. proc carriageReturn {} {
  29.     global mode
  30.     global indentOnCR
  31.     set indentString ""
  32.     deleteText [getPos] [selEnd]
  33.     if {$indentOnCR} {
  34.         set pos [getPos]
  35.         set text [getText [lineStart $pos] $pos]
  36.         for {set i 0; set len [string length $text]} {$i <= $len} {incr i} {
  37.             set c [string index $text $i]
  38.             if {($c != "\t") && ($c != "\ ")} {
  39.                 set indentString [string range $text 0 [expr $i-1]]
  40.                 break
  41.             }
  42.         }
  43.     }
  44.     insertText "\r" $indentString
  45. }
  46.  
  47.  
  48. proc tclCarriageReturn {} {
  49.     global mode
  50.     global _text
  51.     global _returnText
  52.     set pos [getPos]
  53.     set ind [string first ">" [getText [lineStart $pos] $pos]]
  54.     if {$ind < 0} {
  55.         carriageReturn
  56.         return
  57.     }
  58.     set lStart [expr [lineStart $pos]+$ind+2]
  59.     endOfLine
  60.     set _text [getText $lStart [getPos]]
  61.     set fileName [lindex [winNames] 0]
  62.     if {[getPos] != [maxPos]} {
  63.         goto [maxPos]
  64.         insertText -w $fileName $_text
  65.     }
  66.     if {[string first "Toolserver" $fileName] != -1} {
  67.         if {![catch {dosc -n ToolServer -s $_text} _returnText]} {
  68.             insertText "\r" $_returnText
  69.         } else {
  70.             insertText "\r"
  71.         }
  72.         mpwPrompt
  73.     } else {
  74.         uplevel #0 {catch $_text _returnText}
  75.         if {[string length $_returnText]} {
  76.             insertText -w $fileName "\r" $_returnText [shellPrompt]
  77.         } else {
  78.             insertText -w $fileName [shellPrompt]
  79.         }
  80.     }
  81.     unset _text
  82.     unset _returnText
  83. }
  84. bind '\r' carriageReturn
  85. bind '\r' tclCarriageReturn "Csh"
  86. bind '\r' tclCarriageReturn "MPW"
  87.  
  88. proc startMPW {} {
  89.     global toolserverPath
  90.  
  91.     if {![string length [checkRunning ToolServer MPSX toolserverPath]]} return
  92.  
  93.     insertText "Welcome to Alpha's MPW shell (using ToolServer via AppleEvents)."
  94.     bind '\r' tclCarriageReturn "MPW"
  95.     carriageReturn
  96.     mpwPrompt
  97. }
  98. proc mpwPrompt {} {
  99.     insertText "mpw> "
  100. }
  101.  
  102. proc setMPWMode {} {
  103.     changeMode "MPW"
  104. }
  105.  
  106. #    tclCarriageReturn
  107.  
  108.  
  109.  
  110. #=============================================================================
  111. #    Shell Aliases
  112. #=============================================================================
  113.  
  114.  
  115. proc l {args} {
  116.     eval [concat "ls -CF" $args]}
  117.  
  118. proc ll {args} {
  119.     eval [concat "ls -l" $args]}
  120.  
  121.  
  122. proc wc {args} {
  123.     set totChars 0
  124.     set totLines 0
  125.     set totWords 0
  126.     set args [glob -nocomplain $args]
  127.     foreach file $args {
  128.         set id [open $file]
  129.         set chars [string length [set text [read $id]]]
  130.         set lines [llength [split $text "\n"]]
  131.         set words [llength [split $text]]
  132.         insertText [format "\r%8d%8d%8d    $file" $lines $words $chars]
  133.         set totChars [expr $totChars+$chars]
  134.         set totWords [expr $totWords+$words]
  135.         set totLines [expr $totLines+$lines]
  136.         close $id
  137.     }
  138.     if {[llength $args] > 1} {
  139.         insertText [format "\r%8d%8d%8d    total" $totLines $totWords $totChars]
  140.     }
  141. }
  142.  
  143. ###########################################################################
  144. #  better-cp-mv.tcl  -- modification of your routines, by Mark Nagata
  145. #  for Alpha 5.72,  1/04/94
  146. ###########################################################################
  147. proc cp args {
  148.     if {[set len [llength $args]] < 2} {
  149.         error "usage: cp <file1> <file2>\r       cp <file1> .... <dir>"
  150.     }
  151.     set len [expr $len-1]
  152.     if {![regexp {.*[^:]} [lindex $args $len] dir]} {
  153.         set dir [string range [lindex $args $len] 1 end]
  154.     }
  155.     if {![regexp {:} $dir] && $dir != ""} {
  156.         set dir [concat :$dir]}
  157.     set args [lreplace $args $len $len]
  158.     set files {}
  159.     foreach arg $args {
  160.         append files " " [glob $arg]
  161.     }
  162.     set report ""
  163.     if {[llength $files] == 1} {
  164.         set f [lindex $files 0]
  165.         if {[file exists $dir]} {
  166.             set targ $dir:[file tail $f]
  167.             append report $f\ ->\ $targ \r 
  168.             copyFile $f $targ
  169.         } else {
  170.             append report $f\ ->\ $dir \r
  171.             copyFile $f $dir
  172.         }
  173.     } else {
  174.         foreach f $files {
  175.             set targ $dir:[file tail $f]
  176.             append report $f\ ->\ $targ \r
  177.             if {[catch {copyFile $f $targ} that]} {
  178.                 alertnote "Error copying '$f' -> '$targ': $that"
  179.             }
  180.         }
  181.     }
  182.     echo $report
  183. }
  184.  
  185. proc mv args {
  186.     if {[set len [llength $args]] < 2} {
  187.         error "usage: mv <file1> <file2>\r       mv <file1> .... <dir>"
  188.     }
  189.     set len [expr $len-1]
  190.     if {![regexp {.*[^:]} [lindex $args $len] dir]} {
  191.         set dir [string range [lindex $args $len] 1 end]
  192.     }
  193.     if {![regexp {:} $dir] && $dir != ""} {
  194.         set dir [concat :$dir]}
  195.     set args [lreplace $args $len $len]
  196.     set files {}
  197.     foreach arg $args {
  198.         append files " " [glob $arg]
  199.     }
  200.     set report ""
  201.     if {[llength $files] == 1} {
  202.         set f [lindex $files 0]
  203.         if {[file exists $dir]} {
  204.             set targ $dir:[file tail $f]
  205.             append report $f\ >->\ $targ \r
  206.             moveFile $f $targ
  207.         } else {
  208.             append report $f\ >->\ $dir \r
  209.             moveFile $f $dir
  210.         }
  211.     } else {
  212.         foreach f $files {
  213.             set targ $dir:[file tail $f]
  214.             append report $f\ >->\ $targ \r
  215.             if {[catch {moveFile $f $targ} that]} {
  216.                 alertnote "Error moving '$f' -> '$targ': $that"
  217.             }
  218.         }
  219.     }
  220.     echo $report
  221. }
  222.  
  223.  
  224. proc rm args {
  225.     set files {}
  226.     foreach arg $args {
  227.         append files " " [glob $arg]
  228.     }
  229.     foreach f $files {
  230.         removeFile $f
  231.     }
  232. }
  233.  
  234.  
  235. proc getTypeCreator {f} {
  236.     set l [ls -l $f]
  237.     set len [llength $l]
  238.     list [lindex $l [expr $len-4]] [lindex $l [expr $len-3]]
  239. }
  240.